﻿(*
This well-known puzzle, often referred to as the 'Puzzle of Fifteen', became popular in America during the 1870s. The puzzle consists of fifteen square tiles, labelled numerically from 1 to 15. They are arranged in a random ordering within a square tray that is just large enough to hold sixteen tiles in a 4 x 4 grid (see fig. 1). The tiles should then be slid around the tray until they are in the correct ordering as shown in fig. 2, with the blank space at the bottom-right hand corner. The tiles must not be picked out of the tray.

An inversion is when a tile precedes another tile with a lower number on it. The solution state has zero inversions. For example, if, in a 4 x 4 grid, number 12 is top left, then there will be 11 inversions from this tile, as numbers 1-11 come after it. To explain it another way, an inversion is a pair of tiles (a,b) such that a appears before b, but a>b. Count the number of inversions in the grid.

Formula for determining solvability
If the grid width is odd, then the number of inversions in a solvable situation is even.
If the grid width is even, and the blank is on an even row counting from the bottom (second-last, fourth-last etc), then the number of inversions in a solvable situation is odd.
If the grid width is even, and the blank is on an odd row counting from the bottom (last, third-last, fifth-last etc) then the number of inversions in a solvable situation is even.
That gives us this formula for determining solvability:
( (grid width odd) && (#inversions even) )  ||  ( (grid width even) && ((blank on odd row from bottom) == (#inversions even)) )

http://www.cs.bham.ac.uk/~mdr/teaching/modules04/java2/TilesSolvability.html
*)

namespace fifteen_puzzle

open System
open System.Windows
open System.Windows.Controls
open System.Collections.Generic

module MainWindow =

    // Used to find elements
    let (?) (window : Window) name = window.FindName name |> unbox  

    // TODO initialize your controls
    let initControls (window:Window) =

        let w = window
        let aboutButton : Button = w?about
        aboutButton.Click
        |> Event.add(fun _ -> MessageBox.Show "Fifteen Puzzle 1.0\nCopyright (c) 2012 Shengzhou Luo. All rights reserved.\nhttp://15puzzle.codeplex.com/" |> ignore)

        let tiles : Button list = [
            w?Button1; w?Button2; w?Button3; w?Button4;
            w?Button5; w?Button6; w?Button7; w?Button8;
            w?Button9; w?Button10; w?Button11; w?Button12;
            w?Button13; w?Button14; w?Button15; w?Button16 ]

        let gridWidth = 4
        let gridHeight = 4
        let initialNumbers = [1 .. 16]
        let empty = initialNumbers.[initialNumbers.Length-1]
        let numbers = List.toArray initialNumbers

        let rec inversion n list blank =
            match list with
            | [] -> 0
            | head::tail ->
            let result = if head = blank then 0 else (if n > head then 1 else 0)
            result + (inversion n tail blank)

        let rec sumInversion list blank =
            match list with
            | [] -> 0
            | head::tail -> (if head = blank then 0 else inversion head tail blank) + (sumInversion tail blank)

        let isSolvable array blank inversions =
            let i = Array.IndexOf(array, blank)
            let row = i / gridWidth
            let rowFromBottom = gridHeight - row
            ((gridWidth%2=1)&&(inversions%2=0))||((gridWidth%2=0)&&((rowFromBottom%2=1)&&(inversions%2=0))||((rowFromBottom%2=0)&&(inversions%2=1)))

        let printInversions array blank = 
            let inversions = sumInversion (Array.toList array) blank
            let solvable = isSolvable array blank inversions
            let s = sprintf "inversions=%d\tThe puzzle is %s." inversions (if solvable then "solvable" else "unsolvable")
            MessageBox.Show s |> ignore

        let setBlock (b:Button) n =
            b.Content <- n
            if n <> empty then
                b.Visibility <- Visibility.Visible
            else
                b.Visibility <- Visibility.Hidden

        let swap (a : int array) i j = 
            let temp = a.[i]
            a.[i] <- a.[j]
            a.[j] <- temp

        let resetButton : Button = w?reset
        resetButton.Click
        |> Event.add(fun _ ->
            Array.Copy(List.toArray initialNumbers, numbers, initialNumbers.Length)
            for i = 0 to tiles.Length - 1 do
                setBlock tiles.[i] numbers.[i]
            printInversions numbers empty
        )

        let randomButton : Button = w?random
        randomButton.Click
        |> Event.add(fun _ ->
            let rand = new System.Random()
            let nums = List.toArray initialNumbers
            for i = initialNumbers.Length - 1 downto 0 do
                let index = rand.Next(i+1)
                if index <> i then swap nums index i
            Array.Copy(nums, numbers, nums.Length)
            for i = 0 to tiles.Length - 1 do
                setBlock tiles.[i] numbers.[i]
            printInversions numbers empty
        )

        let isAdjacentTuple (x1, y1) (x2, y2) =
            let diff a b = abs(a - b)
            let (s1, s2) = (diff x1 x2, diff y1 y2)
            (s1 + s2 = 1) && (s1 * s2 = 0)

        let isAdjacent i j = i <> j && isAdjacentTuple (i % gridWidth, i / gridWidth) (j % gridWidth, j / gridWidth)

        for i = 0 to tiles.Length - 1 do
            setBlock tiles.[i] numbers.[i]
            tiles.[i].Click
            |> Event.add(fun _ ->
                let j = Array.IndexOf(numbers, empty)
                if isAdjacent i j then
                    swap numbers i j
                    setBlock tiles.[i] numbers.[i]
                    setBlock tiles.[j] numbers.[j]
                    let listEqual list1 list2 = List.forall2 (fun elem1 elem2 -> elem1 = elem2) list1 list2
                    if listEqual (Array.toList numbers) initialNumbers then MessageBox.Show "The puzzle is solved. Well done!" |> ignore
            )

        let toXY i = (i % gridWidth, i / gridWidth)
        let toIndex (x, y) = y * gridWidth + x
        let inGrid (x, y) = (x >= 0 && x < gridWidth && y >= 0 && y < gridHeight)
        let addTuple (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)

        let breadthFirstSearch (obstacles : int array) source destination : (int * int) list =
            let directions = [(-1, 0); (1, 0); (0, -1); (0, 1)]
            let steps = Array.create 16 -1
            let paths = Array.create 16 (-1, -1)
            let q = new Queue<_>()
            q.Enqueue source
            steps.[toIndex source] <- 0
            let mutable found = false
            while not found && q.Count > 0 do
                let (x, y) = q.Dequeue()
                if (x, y) = destination then
                    found <- true
                else
                    let enqueue (x1, y1) =
                        if inGrid (x1, y1) && steps.[toIndex (x1, y1)] = -1 && obstacles.[toIndex (x1, y1)] = 0 then
                            q.Enqueue (x1, y1)
                            steps.[toIndex (x1, y1)] <- steps.[toIndex (x, y)] + 1
                            paths.[toIndex (x1, y1)] <- (x, y)
                    let d = List.map (addTuple (x, y)) directions
                    List.iter enqueue d
            let pathList = new List<int * int>()
            if found then
                let mutable (x, y) = destination
                while x <> -1 && y <> -1 do
                    pathList.Add((x, y))
                    let p = paths.[toIndex (x, y)]
                    x <- fst p
                    y <- snd p
                pathList.Reverse()
            Array.toList (pathList.ToArray())

        let rec swapAlongPath path numbers =
            match path with
            | [] -> ()
            |  first::rest ->
                match rest with
                | [] -> ()
                | second::_ -> swap numbers (toIndex first) (toIndex second)
                swapAlongPath rest numbers

        let rec setArrayAlongPath path (grid : int array) value =
            match path with
            | [] -> ()
            | head::tail ->
                grid.[toIndex head] <- value
                setArrayAlongPath tail grid value

        let printArray array =
            let print i x = printf "%d%s" x (if (i + 1) % gridWidth = 0 then "\n" else "\t")
            Array.iteri print array
            printfn ""

        let printList list =
            let print i x = printf "%d%s" x (if (i + 1) % gridWidth = 0 then "\n" else "\t")
            List.iteri print list
            printfn ""

        let rec printPath path =
            match path with
            | [] -> printfn "\n"
            | (x, y)::tail ->
                printf "(%d, %d)\t" x y
                printPath tail

        let printListInOneLine list =
            match list with
            | [] -> printfn "\n"
            | head::tail -> printfn "%d\t" head

        let diffTuple (x1, y1) (x2, y2) = (abs(x1 - x2), abs(y1 - y2))
        let printTuple (x, y) = printfn "(%d, %d)" x y

        let rec swapByMovingBlank path (board : int array) (obstacles : int array) blank =
            match path with
            | [] -> ()
            | first::rest ->
                match rest with
                | [] -> ()
                | second::_ ->
                    let obstacle = obstacles.[toIndex first]
                    obstacles.[toIndex first] <- -1
                    let blankPosition = toXY (Array.IndexOf(board, blank))
                    let (x1, y1) = blankPosition
                    let (x2, y2) = second
                    if blankPosition = second then
                        printfn "The blank %d is alread at (%d, %d)" blank x1 y1
                    else
                        printfn "Move the blank from (%d, %d) to (%d, %d)" x1 y1 x2 y2
                        let pathForBlank = breadthFirstSearch obstacles blankPosition second
                        printfn "path to move"
                        printPath pathForBlank
                        swapAlongPath pathForBlank board
                        printfn "after moving the blank"
                        printArray board
                    if board.[toIndex second] = blank then
                        swap board (toIndex first) (toIndex second)
                    else
                        printfn "Error! Cannot move the blank from (%d, %d) to (%d, %d)" x1 y1 x2 y2
                    printfn "after moving the tile"
                    printArray board
                    obstacles.[toIndex first] <- obstacle
                    swapByMovingBlank rest board obstacles blank

        // put the last two tiles into the row or column
        let arrangeLastTwoTiles (board : int array) (positions : (int * int) list) (arrangement : (int * int) list) (obstacles : int array) blank (originalNumbers : int list) =
            let blankSource = toXY (Array.IndexOf(board, blank))
            let blankDest = positions.[positions.Length - 2]
            if blankSource <> blankDest then
                let blankPath = breadthFirstSearch obstacles blankSource blankDest
                swapAlongPath blankPath board
            let arrangementPath = [blankDest; arrangement.[arrangement.Length - 2]; arrangement.[arrangement.Length - 1]]
            let checkNumbers = [blank; originalNumbers.[originalNumbers.Length - 2]; originalNumbers.[originalNumbers.Length - 1]]
            printfn "arrangement path"
            printPath arrangementPath
            printfn "check numbers"
            printListInOneLine checkNumbers
            if List.forall2 (fun path num -> board.[toIndex path] = num) arrangementPath checkNumbers then
                printfn "Arrange the tiles into a single row or column"
                swapAlongPath arrangementPath board
                swapAlongPath arrangementPath obstacles
                printfn "board after arrangement"
                printArray board
                printfn "obstacles after arrangement"
                printArray obstacles
            else
                printfn "Error! The numbers along the path are different from expected."

        let solveOneRound (board : int array) (targetBoard : int list) (positions : (int * int) list) (arrangement : (int * int) list) (obstacles : int array) blank offset =
            printfn "solveOneRound\tthe target positions"
            printPath positions
            let check (board : int array) (targetBoard : int list) pos =
                let i = toIndex pos
                board.[i] = targetBoard.[i]
            let organized = List.forall (check board targetBoard) positions
            if organized then
                printfn "This round is already done"
                List.iteri (fun i xy -> obstacles.[toIndex xy] <- i + 1) positions
                printfn "update obstacles"
                printArray obstacles
            else
                printfn "the arrangement"
                printPath arrangement
                let originalNumbers = [for i in positions -> targetBoard.[toIndex i]]
                let solveOneTile i num dest =
                    printf "i=%d\tnum=%d\tdest=" i num
                    printTuple dest
                    // if current tile is the second last one and the last tile is close to the current target position, move the last one away
                    if i = originalNumbers.Length - 2 then
                        let LastTileOfThisRound = originalNumbers.[originalNumbers.Length-1]
                        let lastTilePos = toXY (Array.IndexOf(board, LastTileOfThisRound))
                        // check if the last tile is close to the second last tile's target position
                        let areLastTwoTilesDone = (toXY (Array.IndexOf(board, num)) = dest) && (lastTilePos = arrangement.[arrangement.Length-1])
                        printfn "Last two tiles are %s" (if areLastTwoTilesDone then "done" else "not yet done")
                        let (dx, dy) = diffTuple lastTilePos dest
                        if not areLastTwoTilesDone && (dx <= 1 && dy <= 1) then
                            let (x1, y1) = lastTilePos
                            let (x2, y2) = addTuple dest offset
                            printfn "The last tile %d at (%d, %d) is close to the second last tile %d at (%d, %d)" LastTileOfThisRound x1 y1 num x2 y2
                            printfn "Move %d from (%d, %d) to (%d, %d)" LastTileOfThisRound x1 y1 x2 y2
                            let pathForLastOne = breadthFirstSearch obstacles lastTilePos (x2, y2)
                            printfn "path to move the last one"
                            printPath pathForLastOne
                            swapByMovingBlank pathForLastOne board obstacles blank
                    let source = toXY (Array.IndexOf(board, num))
                    if source = dest then
                        printfn "The tile %d is already at (%d, %d). no moves required" num (fst source) (snd source)
                    else
                        let path = breadthFirstSearch obstacles source dest
                        printfn "path to restore"
                        printPath path
                        printfn "board before"
                        printArray board
                        swapByMovingBlank path board obstacles blank
                        printfn "board after"
                        printArray board
                        let (x, y) = toXY (Array.IndexOf(board, num))
                        if (x, y) <> dest then printfn "Error! %d is  not at (%d, %d) after the moves" num x y
                    obstacles.[toIndex dest] <- i + 1
                    printfn "update obstacles"
                    printArray obstacles
                List.iteri2 solveOneTile originalNumbers arrangement
                // If there are at least two numbers to move, put the last two tiles into the row or column
                if arrangement.Length >= 2 then
                    arrangeLastTwoTiles board positions arrangement obstacles blank originalNumbers

        let compareNumbers (list1 : int list) (list2 : int list) xy =
            let i = toIndex xy
            list1.[i] = list2.[i]

        let isDone (list1 : int list) (list2 : int list) (positions : (int * int) list)=
            List.forall (compareNumbers list1 list2) positions

        let rec circularShift list numbers blank c =
            printf "shift path"
            printPath list
            match list with
            | [] -> ()
            | first::rest ->
                match rest with
                | [] -> ()
                | second::_ ->
                    swap numbers (toIndex first) (toIndex second)
                    printfn "after shift"
                    printArray numbers
                if not (isDone (Array.toList numbers) initialNumbers c) then
                    circularShift rest numbers blank c

        let rec circularShiftFromBlank list numbers blank c =
            match list with
            | [] -> ()
            |  head::tail ->
                if head = toXY (Array.IndexOf(numbers, blank)) then
                    circularShift (head::tail) numbers blank c
                else
                    circularShiftFromBlank tail numbers blank c

        let printArray array =
            let print i x = printf "%d%s" x (if (i+1)%4=0 then "\n" else "\t")
            Array.iteri print array
            printfn ""

        let printList list =
            let print i x = printf "%d%s" x (if (i+1)%4=0 then "\n" else "\t")
            List.iteri print list
            printfn ""

        let solvePuzzle board targetBoard blank =
            let obstacles : int array = Array.zeroCreate 16
            let rowOffset = (1, 2)
            let columnOffset = (2, 1)
            printfn "================================================================"
            solveOneRound board targetBoard [(3, 0); (2, 0); (1, 0); (0, 0)] [(3, 0); (2, 0); (0, 0); (0, 1)] obstacles blank rowOffset
            printfn "after solving this round"
            printArray board
            printfn "================================================================"
            solveOneRound board targetBoard [(0,3);(0,2);(0,1)] [(0,3);(0,1);(1,1)] obstacles blank columnOffset
            printfn "after solving this round"
            printArray board
            printfn "================================================================"
            solveOneRound board targetBoard [(3,1);(2,1);(1,1)] [(3,1);(1,1);(1,2)] obstacles blank rowOffset
            printfn "after solving this round"
            printArray board
            printfn "================================================================"
            solveOneRound board targetBoard [(1,3);(1,2)] [(1,2);(2,2)] obstacles blank columnOffset
            printfn "after solving this round"
            printArray board
            printfn "================================================================"
            // After 12 shifts, the last 4 pieces at the bottom right corner will go back to the initial state.
            // If the 15 puzzle is solvable, the last 4 pieces will be at their right positions after at most 11 shifts.
            let c = [(2,2); (3,2); (3,3); (2,3)]
            let circle = c @ c @ c @ c
            let isFinished1 = isDone (Array.toList numbers) initialNumbers c
            if not isFinished1 then
                printfn "circular shift"
                circularShiftFromBlank circle numbers empty c
                printfn "result"
                printArray numbers
            isDone (Array.toList numbers) initialNumbers c

        let solveButton : Button = w?solve
        solveButton.Click
        |> Event.add(fun _ ->
            let inversions = sumInversion (Array.toList numbers) empty
            let solvable = isSolvable numbers empty inversions
            if solvable then
                let isFinished = solvePuzzle numbers initialNumbers empty
                for i = 0 to tiles.Length - 1 do
                    setBlock tiles.[i] numbers.[i]
                let s = sprintf "The puzzle is solvable %s" (if isFinished then "and I solved it." else "but I cannot solve it.")
                MessageBox.Show s |> ignore
            else
                MessageBox.Show "The puzzle is unsolvable." |> ignore
        )
